unit FixOleContainer;

interface

uses Windows, Messages, CommCtrl, ActiveX, OleDlg, SysUtils, Classes,
     Controls, Forms, Menus, Graphics, ComObj, OleCtnrs, ExtCtrls;


type
  TFixOleContainer = class(TOleContainer)
  private
    { Private declarations }
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure AdjustColors(Bevel: TPanelBevel; var TopColor, BottomColor: tColor;
    HighLightColor, ShadowColor: tColor);
begin
  TopColor := HighLightColor;
  if Bevel = bvLowered then TopColor := ShadowColor;
  BottomColor := ShadowColor;
  if Bevel = bvLowered then BottomColor := HighLightColor;
end;

procedure TFixOleContainer.Paint;

function IsDocObj : boolean;
var
wnd: HWND;
begin
(Self as IOleInPlaceSite).GetWindow(wnd);
result := wnd = Handle;
end;

function GetDrawAspect (Check : TOleContainer) : LongInt;
begin
  if Check.Iconic then Result := DVASPECT_ICON
  else Result := DVASPECT_CONTENT;
end;

procedure GetViewSize (Check : TOleContainer; var ViewSize : TPoint);
begin
  Check.OleObjectInterface.GetExtent(DVASPECT_CONTENT, ViewSize);
end;

function HimetricToPixels(const P: TPoint): TPoint;
begin
  Result.X := MulDiv(P.X, Screen.PixelsPerInch, 2540);
  Result.Y := MulDiv(P.Y, Screen.PixelsPerInch, 2540);
end;


var
  W, H: Integer;
  S: TPoint;
  R, CR: TRect;
  X, Y : integer;
  EmptyText : string;
  TopColor, BottomColor : TColor;
  ViewSize : TPoint;
  DrawAspect : LongInt;
begin
  CR := Rect(0,0,Width,Height);

  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Color := Color;
  Canvas.FillRect(CR);
  if BorderStyle=bsSingle then
   begin
   AdjustColors(bvLowered, TopColor, BottomColor, clBtnHighlight, clBlack);
   Frame3D(Canvas, CR, TopColor, BottomColor, 1);
   AdjustColors(bvLowered, TopColor, BottomColor, clBtnFace, clBlack);
   Frame3D(Canvas, CR, TopColor, BottomColor, 1);
   end;

  if IsDocObj and (State = osUIActive) then exit;
  if State = osEmpty then begin
    with Canvas do begin
      EmptyText := Caption;
      if EmptyText = '' then EmptyText := '';
      x := round((CR.Right-Canvas.TextWidth(EmptyText))/2);
      y := round((CR.Bottom-Canvas.TextHeight(EmptyText))/2);
      TextOut(x,y,EmptyText);
    end;
    if Focused then Canvas.DrawFocusRect(CR);
    exit;
  end;
  if OleObjectInterface <> nil then begin
    W := CR.Right - CR.Left;
    H := CR.Bottom - CR.Top;
    GetViewSize(Self, ViewSize);
    DrawAspect := GetDrawAspect(Self);
    S := HimetricToPixels(ViewSize);
    if (DrawAspect = DVASPECT_CONTENT) and (SizeMode = smScale) then
      if W * S.Y > H * S.X then begin
        S.X := S.X * H div S.Y;
        S.Y := H;
      end
      else begin
        S.Y := S.Y * W div S.X;
        S.X := W;
      end;
    if (DrawAspect = DVASPECT_ICON) or (SizeMode = smCenter) or
       (SizeMode = smScale) then begin
      R.Left := (W - S.X) div 2;
      R.Top := (H - S.Y) div 2;
      R.Right := R.Left + S.X;
      R.Bottom := R.Top + S.Y;
    end
    else if SizeMode = smClip then begin
      SetRect(R, CR.Left, CR.Top, S.X, S.Y);
      IntersectClipRect(Canvas.Handle, CR.Left, CR.Top, CR.Right, CR.Bottom);
    end
    else SetRect(R, CR.Left, CR.Top, W, H);
    OleDraw(OleObjectInterface, DrawAspect, Canvas.Handle, R);
  end;
  if Focused then Canvas.DrawFocusRect(CR);
end;

procedure Register;
begin
  RegisterComponents('System', [TFixOleContainer]);
end;

end.
